unit ShellTools;

interface

uses
  SysUtils, Forms, Classes;

function OpenDocument( const doc: string; showerrmsg: boolean= true ): boolean;
function AssociatedExecutable( const doc: string ): string; // no anda
function DesktopDir: string;
function CreateLink( const PathLink, PathObj: string;
                     WindowState: TWindowState;
                     const ParamsObj: string= '';
                     const WorkDir: string= '';
                     ShortCut: TShortCut= 0;
                     const LinkDesc: string= '' ): HResult;

implementation

uses
  Windows, ShellAPI, Dialogs, ComObj, ShlObj, ActiveX;

const
  HOTKEYF_ALT      = $400;
  HOTKEYF_CONTROL  = $200;
  HOTKEYF_EXT	   = $800;
  HOTKEYF_SHIFT    = $100;

function ShShortCutTo( shsc: TShortCut ): TShortCut;
begin
  result := 0;
end;

function ToShShortCut( sc: TShortCut ): TShortCut;
begin
  result := lo(sc) or (hi(sc) shl 3);
end;

function DesktopDir: string;
var
  pidl : PItemIDList;
  d    : array [0..MAX_PATH] of char;
begin
  SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,pidl);
  SHGetPathFromIDList(pidl,d);
  result := d;
end;

function CreateLink( const PathLink, PathObj: string;
                     WindowState: TWindowState;
                     const ParamsObj: string= '';
                     const WorkDir: string= '';
                     ShortCut: TShortCut= 0;
                     const LinkDesc: string= '' ): HResult;
const
  ShowCommands: array[TWindowState] of Integer =
    (SW_SHOWNORMAL, SW_SHOWMINNOACTIVE, SW_SHOWMAXIMIZED);
var
  isl : IShellLink;
  ipf : IPersistFile;
  wc  : array [0..MAX_PATH] of WideChar;
  wd  : string;
begin
  isl := CreateCOMObject(CLSID_ShellLink) as IShellLink;
  result := isl.SetPath(PChar(PathObj));
  if result<>NOERROR then exit;
  if ParamsObj>'' then
  begin
    result := isl.SetArguments(PChar(ParamsObj));
    if result<>NOERROR then exit;
  end;
  if WorkDir>'' then wd := WorkDir
                else wd := ExtractFilePath(PathObj);
  if wd>'' then
  begin
    result := isl.SetWorkingDirectory(PChar(wd));
    if result<>NOERROR then exit;
  end;
  if LinkDesc>'' then
  begin
    result := isl.SetDescription(PChar(LinkDesc));
    if result<>NOERROR then exit;
  end;
  result := isl.SetShowCmd(ShowCommands[WindowState]);
  if result<>NOERROR then exit;
  if ShortCut<>0 then
  begin
    result := isl.SetHotkey(ToShShortCut(ShortCut));
    if result<>NOERROR then exit;
  end;
  ipf := isl as IPersistFile;
  result := ipf.Save(StringToWideChar(PathLink,wc,SizeOf(wc)),true);
end;

function OpenDocument( const doc: string; showerrmsg: boolean= true ): boolean;
resourcestring
  rsMsgErrOpenDoc = 'Error "%s" al tratar de abrir "%s"';
var
  e : integer;
  d : string;
begin
  e := ShellExecute(Application.Handle, 'open', PChar(doc), nil, nil, SW_SHOWNORMAL);
  if (e<=32) and showerrmsg then MessageDlg(format(rsMsgErrOpenDoc,[SysErrorMessage(e),doc]),mtError,[mbOk],0);
  result := e>32;
end;

function AssociatedExecutable( const doc: string ): string;
var
  h : THandle;
begin
  if doc>'' then
  begin
    SetLength(result,MAX_PATH);
    h := FindExecutable(PChar(doc),nil,PChar(result));
    if h<=32 then result := '';
  end
  else result := '';
end;

end.
